home *** CD-ROM | disk | FTP | other *** search
- Path: uunet!husc6!bloom-beacon!mit-eddie!uw-beaver!tektronix!tekgen!tekred!games-request
- From: games-request@tekred.TEK.COM
- Newsgroups: comp.sources.games
- Subject: v03i097: go - go board manager sources, Part01/05
- Message-ID: <2268@tekred.TEK.COM>
- Date: 9 Mar 88 17:55:41 GMT
- Sender: billr@tekred.TEK.COM
- Lines: 2013
- Approved: billr@tekred.TEK.COM
-
- Submitted by: Fred Hansen <wjh+@andrew.cmu.edu>
- Comp.sources.games: Volume 3, Issue 97
- Archive-name: go/Part01
-
- [Here's a good project for a go or Pascal lover. As noted
- in the README file, this will take some some work to get
- it running on Unix. If somewon takes up the challenge,
- please send me your results so I can share them with
- the rest of the net. -br
- P.S. Three of the files have ^G characters in them. If they
- unpack with errors, look for the comment "control-G" and fix
- the "write('');" to be "write('^G');".]
-
- #! /bin/sh
- # This is a shell archive. Remove anything before this line, then unpack
- # it by saving it into a file and typing "sh file". To overwrite existing
- # files, type "sh file -c". You can also feed this as standard input via
- # unshar, or by typing "sh <file", e.g.. If this archive is complete, you
- # will see the following message at the end:
- # "End of archive 1 (of 5)."
- # Contents: README MANIFEST goCom.pas goPlayUtils.pas
- # Wrapped by billr@saab on Wed Mar 9 09:14:43 1988
- PATH=/bin:/usr/bin:/usr/ucb ; export PATH
- if test -f README -a "${1}" != "-c" ; then
- echo shar: Will not over-write existing file \"README\"
- else
- echo shar: Extracting \"README\" \(597 characters\)
- sed "s/^X//" >README <<'END_OF_README'
- XThis go board manager and rudimentary go player was written by
- XStoney Ballard at Perq Systems in 1983-1984. It is written in
- XPerq Pascal and utilizes some Perq libraries for I/O. The code
- Xis offered here if someone is interested to convert it to Unix.
- X
- XThe wonderful part about it is that a game is recorded as a tree
- Xand can be played forward or backward, branching at any point
- Xwhere there were alternate moves.
- X
- XFor some time, this program was also used to generate the go
- Xboards displayed in the American Go Journal. For this it used
- Xsome large font digits which are now lost.
- X
- XFred Hansen
- END_OF_README
- if test 597 -ne `wc -c <README`; then
- echo shar: \"README\" unpacked with wrong size!
- fi
- # end of overwriting check
- fi
- if test -f MANIFEST -a "${1}" != "-c" ; then
- echo shar: Will not over-write existing file \"MANIFEST\"
- else
- echo shar: Extracting \"MANIFEST\" \(414 characters\)
- sed "s/^X//" >MANIFEST <<'END_OF_MANIFEST'
- X File Name Archive # Description
- X-----------------------------------------------------------
- X MANIFEST 1 This shipping list
- X README 1
- X go.pas 4
- X goBoard.pas 3
- X goCom.pas 1
- X goMenu.pas 5
- X goMgr.pas 4
- X goPlayUtils.pas 1
- X goPlayer.pas 2
- X goTree.pas 3
- END_OF_MANIFEST
- if test 414 -ne `wc -c <MANIFEST`; then
- echo shar: \"MANIFEST\" unpacked with wrong size!
- fi
- # end of overwriting check
- fi
- if test -f goCom.pas -a "${1}" != "-c" ; then
- echo shar: Will not over-write existing file \"goCom.pas\"
- else
- echo shar: Extracting \"goCom.pas\" \(3924 characters\)
- sed "s/^X//" >goCom.pas <<'END_OF_goCom.pas'
- X{---------------------------------------------------------------------------}
- X{ goCom.Pas }
- X{ }
- X{ Common Data for Go }
- X{ Copyright (c) 1982 by Three Rivers Computer Corp. }
- X{ }
- X{ Written: June 3, 1982 by Stoney Ballard }
- X{ Edit History: }
- X{ June 3, 1982 Started }
- X{ June 4, 1982 Add dead group removal }
- X{ June 10, 1982 Use new go file manager }
- X{ Nov 9, 1982 Split From Go.Pas }
- X{ V3.5 - Jan 11, 1983 Fixed bug in printer that screwed capture count }
- X{ V3.6 - Jan 14, 1983 Changed Scoring and board coordinates to conform to }
- X{ tournament rules }
- X{ V3.7 - Jan 17, 1983 added computer player!!!! }
- X{ V3.8 - Mar 8, 1983 Added PrintDiagram }
- X{ Made board 34 grid for printing }
- X{ V3.9 - May 3, 1983 Add board print size switch and command }
- X{---------------------------------------------------------------------------}
- X
- X
- Xmodule goCom;
- X
- Xexports
- X
- Ximports IO_Others from IO_Others;
- Ximports fileDefs from fileDefs;
- X
- Xconst
- X version = '3.9';
- X
- X numPoints = 19;
- X maxPoint = numPoints - 1;
- X curC = 31;
- X maxTagLen = 16;
- X
- X charHeight = 13;
- X charWidth = 9;
- X
- X boardWin = 1;
- X menuWin = 2;
- X statWin = 3;
- X bWinX = 0;
- X bWinY = 0;
- X bWinW = 768;
- X bWinH = 768;
- X mWinX = 0;
- X mWinY = 768;
- X mWinW = 768;
- X mWinH = 192;
- X sWinX = 0;
- X sWinY = 960;
- X sWinW = 768;
- X sWinH = 64;
- X
- X promptX = sWinX + 32;
- X lineY = 4;
- X lineDel = 2;
- X promptLine = 1;
- X tagLine = 2;
- X cmtLine = 3;
- X
- X boardX = bWinX + 64;
- X boardY = bWinY + 32;
- X pBoardX = bWinX + 44; { for printing }
- X pBoardY = bWinY + 24;
- X
- X passX = bWinX + 321;
- X passY = bWinY + 712; { 712 }
- X passW = 126;
- X passH = 13;
- X
- X captBX = bWinX + 64;
- X captWX = bWinX + 578;
- X captY = bWinY + 712; { 712 }
- X
- X captNBX = captBX + 45;
- X captNWX = captWX + 45;
- X captNY = bWinY + 732; { 732 }
- X
- X turnX = bWinX + 325;
- X turnY = bWinY + 752; { 752 }
- X
- X none = -1;
- X mInit = 1;
- X mSetHc = 2;
- X mPass = 3;
- X mScore = 4;
- X mForToBr = 5;
- X mBackToBr = 6;
- X mBackToStone = 7;
- X mForToLeaf = 8;
- X mPutTag = 9;
- X mGotoTag = 10;
- X mGotoRoot = 11;
- X mPutCmt = 12;
- X mReadFile = 13;
- X mWriteFile = 14;
- X mPruneBranches = 15;
- X mTogNums = 16;
- X mPrintBoard = 17;
- X mStepToTag = 18;
- X mSetStepTag = 19;
- X mQuit = 20;
- X mBackOne = 21;
- X mForOne = 22;
- X mEraseMove = 23;
- X mAutoPlay = 24;
- X mPlayMyself = 25;
- X mSetPlayLevel = 26;
- X mDebug = 27;
- X mRefBoard = 28;
- X mShoState = 29;
- X mPrintDiag = 30;
- X mBoardSize = 31;
- X mLast = 31; { the last command in the menu }
- X mPlaceStone = 32; { this command is not in the menu }
- X mCtlC = 33; { nor is this }
- X
- Xtype
- X bVal = (black, white, empty, alternate);
- X sType = black..white;
- X bRec = record
- X val: bval;
- X xOfs, yOfs: integer;
- X mNum: integer;
- X marked: boolean;
- X end;
- X
- X boardArray = array[0..maxPoint] of array[0..maxPoint] of bRec;
- X
- X picBuf = array[0..63] of array[0..3] of integer;
- X pPicBuf = ^picBuf;
- X
- Xvar
- X board: boardArray;
- X captures: array[sType] of integer;
- X moveNum: integer;
- X koX, koY: integer;
- X selCursor: curPatPtr;
- X dotSX, dotSY: integer;
- X passShowing: boolean;
- X numbEnabled: boolean;
- X treeDirty: boolean;
- X gameFName: pathName;
- X debug: boolean;
- X printLarge: boolean;
- X
- Xprivate
- X
- Xprocedure comBug;
- Xbegin { comBug }
- Xend. { comBug }
- END_OF_goCom.pas
- if test 3924 -ne `wc -c <goCom.pas`; then
- echo shar: \"goCom.pas\" unpacked with wrong size!
- fi
- # end of overwriting check
- fi
- if test -f goPlayUtils.pas -a "${1}" != "-c" ; then
- echo shar: Will not over-write existing file \"goPlayUtils.pas\"
- else
- echo shar: Extracting \"goPlayUtils.pas\" \(50784 characters\)
- sed "s/^X//" >goPlayUtils.pas <<'END_OF_goPlayUtils.pas'
- Xmodule goPlayUtils;
- X
- Xexports
- X
- Ximports goCom from goCom;
- X
- Xconst
- X iNil = 32767; { a distinguished value like nil }
- X maxGroup = 512;
- X maxSPoint = 16;
- X
- Xtype
- X intBoard = array[-2..maxPoint + 2] of array[-2..maxPoint + 2] of integer;
- X
- X boolBoard = array[-2..maxPoint + 2] of array[-2..maxPoint + 2] of boolean;
- X
- X point = record
- X px, py: integer;
- X end;
- X
- X pointList = record
- X p: array[1..400] of point;
- X indx: integer;
- X end;
- X
- X sPointList = record
- X p: array[1..maxSPoint] of point;
- X indx: integer;
- X end;
- X
- X intList = record
- X indx: integer;
- X v: array[1..400] of integer;
- X end;
- X
- X sgRec = record
- X w, s, sm: integer;
- X end;
- X
- X groupRec = record
- X groupMark: integer;
- X atLevel: integer;
- X isLive: boolean;
- X isDead: boolean;
- X libC: integer;
- X numEyes: integer;
- X size: integer;
- X lx, ly: integer;
- X end;
- X
- Xvar
- X kleim, ekstre, bord, ndbord, sGroups, threatBord: intBoard;
- X groupIDs, connectMap, protPoints: intBoard;
- X groupSeen, legal: boolBoard;
- X maxGroupID: integer;
- X pList, pList1, plist2, plist3, pPlist: pointList;
- X nlcGroup, aList: intList;
- X sList: array[1..400] of sgRec;
- X gList: array[0..maxGroup] of groupRec;
- X killFlag: boolean;
- X numCapt: integer;
- X utilPlayLevel: integer;
- X treeLibLim: integer;
- X mySType: sType;
- X showTrees: boolean;
- X sGlist: array[1..maxGroup] of integer;
- X depthLimit: integer;
- X markBoard: intBoard;
- X marker: integer;
- X
- Xfunction saveable(gx, gy: integer; var savex, savey: integer): boolean;
- Xfunction killable(gx, gy: integer; var killx, killy: integer): boolean;
- Xprocedure initBoolBoard(var bb: boolBoard);
- Xprocedure spanGroup(x, y: integer; var libs: pointList);
- Xfunction abs(i: integer): integer;
- Xprocedure intersectPlist(var p1, p2, pr: pointList);
- Xprocedure initArray(var ary: intBoard);
- Xprocedure initState;
- Xprocedure copyArray(var dAry, sAry: intBoard);
- Xprocedure steik;
- Xprocedure spread;
- Xprocedure respreicen;
- Xprocedure plei(x, y, z: integer);
- Xprocedure genState;
- Xprocedure saveState;
- Xprocedure restoreState;
- Xfunction tencen(x, y: integer): integer;
- Xprocedure genConnects;
- Xprocedure initGPUtils;
- Xprocedure sortLibs;
- X
- Xprivate
- X
- Ximports screen from screen;
- Ximports raster from raster;
- Ximports goBoard from goBoard;
- Ximports io_others from io_others;
- X
- Xtype
- X playType = (rem, add, chLib, reMap);
- X
- X playRec = record
- X gID: integer;
- X case kind: playType of
- X rem, add:
- X (who, xl, yl, nextGID, sNumber: integer);
- X chLib:
- X (oldLC, oldLevel: integer);
- X reMap:
- X (oldGID: integer)
- X end;
- X
- Xvar
- X adjInAtari, adj2Libs: boolean;
- X intersectNum, spanNum, libMark: integer;
- X playStack: array[1..1024] of playRec;
- X playMark: integer;
- X newGID: integer;
- X tryLevel: integer;
- X grpMark: integer;
- X gMap: array[0..maxGroup] of integer;
- X dbStop, inGenState: boolean;
- X
- Xexception screwup;
- X
- Xprocedure pause;
- Xbegin { pause }
- X{ if dbStop and not inGenState then
- X begin
- X while not tabswitch do;
- X repeat
- X if tabYellow then
- X dbStop := false;
- X until not tabswitch;
- X end; }
- Xend { pause };
- X
- Xprocedure sstone(w, x, y, numb: integer);
- Xvar
- X cx, cy: integer;
- Xbegin { sstone }
- X sReadCursor(cx, cy);
- X if w = 1 then
- X placeStone(mySType, x, y, 0, 0, numb)
- X else if mySType = white then
- X placeStone(black, x, y, 0, 0, numb)
- X else
- X placeStone(white, x, y, 0, 0, numb);
- X sSetCursor(cx, cy);
- Xend { sstone };
- X
- Xprocedure rstone(x, y: integer);
- Xvar
- X cx, cy: integer;
- Xbegin { rstone }
- X sReadCursor(cx, cy);
- X remStone(x, y);
- X sSetCursor(cx, cy);
- Xend { rstone };
- X
- Xprocedure initBoolBoard(var bb: boolBoard);
- Xvar
- X i, j: integer;
- Xbegin { initBoolBoard }
- X for i := 0 to maxPoint do
- X for j := 0 to maxPoint do
- X bb[i, j] := false;
- Xend { initBoolBoard };
- X
- Xfunction abs(i: integer): integer;
- Xbegin { abs }
- X if i < 0 then
- X abs := -i
- X else
- X abs := i;
- Xend { abs };
- X
- Xprocedure sortLibs;
- Xvar
- X i, j, t: integer;
- Xbegin { sortLibs }
- X for i := 1 to maxGroupID do
- X sGList[i] := i;
- X for i := 1 to maxGroupID - 1 do
- X for j := i + 1 to maxGroupID do
- X if gList[sGlist[i]].libC > gList[sGlist[j]].libC then
- X begin
- X t := sGList[i];
- X sGlist[i] := sGlist[j];
- X sGlist[j] := t;
- X end;
- Xend { sortLibs };
- X
- Xprocedure spanGroup(x, y: integer; var libs: pointList);
- Xvar
- X lookFor: integer;
- X
- X procedure span(x, y: integer);
- X begin { span }
- X markBoard[x, y] := marker;
- X if bord[x, y] = 0 then
- X begin
- X libs.indx := libs.indx + 1;
- X libs.p[libs.indx].px := x;
- X libs.p[libs.indx].py := y;
- X end
- X else if bord[x, y] = lookFor then
- X begin
- X groupSeen[x, y] := true;
- X if (x > 0) and (markBoard[x - 1, y] <> marker) then
- X span(x - 1, y);
- X if (y > 0) and (markBoard[x, y - 1] <> marker) then
- X span(x, y - 1);
- X if (x < maxPoint) and (markBoard[x + 1, y] <> marker) then
- X span(x + 1, y);
- X if (y < maxPoint) and (markBoard[x, y + 1] <> marker) then
- X span(x, y + 1);
- X end
- X else if gList[gMap[groupIDs[x, y]]].libC = 1 then
- X adjInAtari := true
- X else if (gList[gMap[groupIDs[x, y]]].libC = 2) and
- X (not gList[gMap[groupIDs[x, y]]].isLive) then
- X adj2Libs := true;
- X end { span };
- X
- Xbegin { spanGroup }
- X marker := marker + 1;
- X if marker = 0 then
- X begin
- X initArray(markBoard);
- X marker := 1;
- X end;
- X adjInAtari := false;
- X adj2Libs := false;
- X lookFor := bord[x, y];
- X libs.indx := 0;
- X span(x, y);
- Xend { spanGroup };
- X
- Xprocedure sSpanGroup(x, y: integer; var libs: sPointList);
- Xvar
- X lookFor: integer;
- X
- X procedure span(x, y: integer);
- X begin { span }
- X markBoard[x, y] := marker;
- X if bord[x, y] = 0 then
- X begin
- X libs.indx := libs.indx + 1;
- X if libs.indx <= maxSPoint then
- X begin
- X libs.p[libs.indx].px := x;
- X libs.p[libs.indx].py := y;
- X end;
- X end
- X else if bord[x, y] = lookFor then
- X begin
- X groupSeen[x, y] := true;
- X if (x > 0) and (markBoard[x - 1, y] <> marker) then
- X span(x - 1, y);
- X if (y > 0) and (markBoard[x, y - 1] <> marker) then
- X span(x, y - 1);
- X if (x < maxPoint) and (markBoard[x + 1, y] <> marker) then
- X span(x + 1, y);
- X if (y < maxPoint) and (markBoard[x, y + 1] <> marker) then
- X span(x, y + 1);
- X end
- X else if gList[gMap[groupIDs[x, y]]].libC = 1 then
- X adjInAtari := true
- X else if (gList[gMap[groupIDs[x, y]]].libC = 2) and
- X (not gList[gMap[groupIDs[x, y]]].isLive) then
- X adj2Libs := true;
- X end { span };
- X
- Xbegin { sSpanGroup }
- X marker := marker + 1;
- X if marker = 0 then
- X begin
- X initArray(markBoard);
- X marker := 1;
- X end;
- X adjInAtari := false;
- X adj2Libs := false;
- X lookFor := bord[x, y];
- X libs.indx := 0;
- X span(x, y);
- Xend { sSpanGroup };
- X
- Xprocedure listAdjacents(x, y: integer; var iL: intList);
- Xvar
- X me, him: integer;
- X
- X procedure span(x, y: integer);
- X begin { span }
- X markBoard[x, y] := marker;
- X if bord[x, y] = me then
- X begin
- X if (x > 0) and (markBoard[x - 1, y] <> marker) then
- X span(x - 1, y);
- X if (x < maxPoint) and (markBoard[x + 1, y] <> marker) then
- X span(x + 1, y);
- X if (y > 0) and (markBoard[x, y - 1] <> marker) then
- X span(x, y - 1);
- X if (y < maxPoint) and (markBoard[x, y + 1] <> marker) then
- X span(x, y + 1);
- X end
- X else if bord[x, y] = him then
- X if gList[gMap[groupIDs[x, y]]].groupMark <> grpMark then
- X begin
- X gList[gMap[groupIDs[x, y]]].groupMark := grpMark;
- X iL.indx := iL.indx + 1;
- X iL.v[iL.indx] := gMap[groupIDs[x, y]];
- X end;
- X end { span };
- X
- Xbegin { listAdjacents }
- X grpMark := grpMark + 1;
- X marker := marker + 1;
- X if marker = 0 then
- X begin
- X initArray(markBoard);
- X marker := 1;
- X end;
- X iL.indx := 0;
- X me := bord[x, y];
- X him := -me;
- X span(x, y);
- Xend { listAdjacents };
- X
- Xprocedure listDiags(x, y: integer; var diags: sPointList);
- Xvar
- X me: integer;
- X
- X procedure span(x, y: integer);
- X begin { span }
- X markBoard[x, y] := marker;
- X if (x > 0) and (y > 0) and
- X (bord[x - 1, y - 1] = 0) and
- X (bord[x, y - 1] <> me) and
- X (bord[x - 1, y] <> me) and
- X (markBoard[x - 1, y - 1] <> marker) then
- X begin
- X markBoard[x - 1, y - 1] := marker;
- X diags.indx := diags.indx + 1;
- X if diags.indx <= maxSPoint then
- X with diags.p[diags.indx] do
- X begin
- X px := x - 1;
- X py := y - 1;
- X end;
- X end;
- X if (x < maxPoint) and (y > 0) and
- X (bord[x + 1, y - 1] = 0) and
- X (bord[x, y - 1] <> me) and
- X (bord[x + 1, y] <> me) and
- X (markBoard[x + 1, y - 1] <> marker) then
- X begin
- X markBoard[x + 1, y - 1] := marker;
- X diags.indx := diags.indx + 1;
- X if diags.indx <= maxSPoint then
- X with diags.p[diags.indx] do
- X begin
- X px := x + 1;
- X py := y - 1;
- X end;
- X end;
- X if (x > 0) and (y < maxPoint) and
- X (bord[x - 1, y + 1] = 0) and
- X (bord[x, y + 1] <> me) and
- X (bord[x - 1, y] <> me) and
- X (markBoard[x - 1, y + 1] <> marker) then
- X begin
- X markBoard[x - 1, y + 1] := marker;
- X diags.indx := diags.indx + 1;
- X if diags.indx <= maxSPoint then
- X with diags.p[diags.indx] do
- X begin
- X px := x - 1;
- X py := y + 1;
- X end;
- X end;
- X if (x < maxPoint) and (y < maxPoint) and
- X (bord[x + 1, y + 1] = 0) and
- X (bord[x, y + 1] <> me) and
- X (bord[x + 1, y] <> me) and
- X (markBoard[x + 1, y + 1] <> marker) then
- X begin
- X markBoard[x + 1, y + 1] := marker;
- X diags.indx := diags.indx + 1;
- X if diags.indx <= maxSPoint then
- X with diags.p[diags.indx] do
- X begin
- X px := x + 1;
- X py := y + 1;
- X end;
- X end;
- X if (x > 0) and (bord[x - 1, y] = me) and
- X (markBoard[x - 1, y] <> marker) then
- X span(x - 1, y);
- X if (x < maxPoint) and (bord[x + 1, y] = me) and
- X (markBoard[x + 1, y] <> marker) then
- X span(x + 1, y);
- X if (y > 0) and (bord[x, y - 1] = me) and
- X (markBoard[x, y - 1] <> marker) then
- X span(x, y - 1);
- X if (y < maxPoint) and (bord[x, y + 1] = me) and
- X (markBoard[x, y + 1] <> marker) then
- X span(x, y + 1);
- X end { span };
- X
- Xbegin { listDiags }
- X me := bord[x, y];
- X diags.indx := 0;
- X marker := marker + 1;
- X if marker = 0 then
- X begin
- X initArray(markBoard);
- X marker := 1;
- X end;
- X span(x, y);
- Xend { listDiags };
- X
- Xprocedure intersectPlist(var p1, p2, pr: pointList);
- Xvar
- X i, j, k: integer;
- Xbegin { intersectPlist }
- X marker := marker + 1;
- X if marker = 0 then
- X begin
- X initArray(markBoard);
- X marker := 1;
- X end;
- X pr.indx := 0;
- X for i := 1 to p1.indx do
- X with p1.p[i] do
- X markBoard[px, py] := marker;
- X j := 0;
- X for i := 1 to p2.indx do
- X with p2.p[i] do
- X if markBoard[px, py] = marker then
- X begin
- X j := j + 1;
- X pr.p[j] := p2.p[i];
- X end;
- X pr.indx := j;
- Xend { intersectPlist };
- X
- Xprocedure initArray(var ary: intBoard);
- Xvar
- X i, j: integer;
- Xbegin { initArray }
- X for i := 0 to maxPoint do
- X for j := 0 to maxPoint do
- X ary[i, j] := 0;
- Xend { initArray };
- X
- Xprocedure initState;
- Xvar
- X i, j: integer;
- Xbegin { initState }
- X for i := -2 to maxPoint + 2 do
- X for j := -2 to maxPoint + 2 do
- X begin
- X ekstre[i, j] := 0;
- X kleim[i, j] := 0;
- X groupIDs[i, j] := 0;
- X connectMap[i, j] := 0;
- X protPoints[i, j] := 0;
- X end;
- Xend { initState };
- X
- Xprocedure copyArray(var dAry, sAry: intBoard);
- Xvar
- X i, j: integer;
- Xbegin { copyArray }
- X for i := 0 to maxPoint do
- X for j := 0 to maxPoint do
- X dAry[i, j] := sAry[i, j];
- Xend { copyArray };
- X
- X{
- X generates a one-point spread in the force field array (kleim)
- X
- X the spread from a single point after four calls is:
- X
- X 1
- X 2 2 2
- X 2 4 6 4 2
- X 2 4 8 10 8 4 2
- X 1 2 6 10 62 10 6 2 1
- X 2 4 8 10 8 4 2
- X 2 4 6 4 2
- X 2 2 2
- X 1
- X
- X}
- Xprocedure steik;
- Xvar
- X i, j: integer;
- Xbegin { steik }
- X initArray(ekstre);
- X for i := 0 to maxPoint do
- X for j := 0 to maxPoint do
- X begin
- X ekstre[i, j] := ekstre[i, j] + kleim[i, j];
- X if kleim[i, j] > 0 then
- X begin
- X if i > 0 then
- X ekstre[i - 1, j] := ekstre[i - 1, j] + 1;
- X if j > 0 then
- X ekstre[i, j - 1] := ekstre[i, j - 1] + 1;
- X if i < maxPoint then
- X ekstre[i + 1, j] := ekstre[i + 1, j] + 1;
- X if j < maxPoint then
- X ekstre[i, j + 1] := ekstre[i, j + 1] + 1;
- X end
- X else if kleim[i, j] < 0 then
- X begin
- X if i > 0 then
- X ekstre[i - 1, j] := ekstre[i - 1, j] - 1;
- X if j > 0 then
- X ekstre[i, j - 1] := ekstre[i, j - 1] - 1;
- X if i < maxPoint then
- X ekstre[i + 1, j] := ekstre[i + 1, j] - 1;
- X if j < maxPoint then
- X ekstre[i, j + 1] := ekstre[i, j + 1] - 1;
- X end;
- X end;
- X copyArray(kleim, ekstre);
- Xend { steik };
- X
- X{
- X sets up kleim from the current board position
- X}
- Xprocedure spread;
- Xvar
- X i, j: integer;
- Xbegin { spread }
- X for i := 0 to maxPoint do
- X for j := 0 to maxPoint do
- X kleim[i, j] := ndbord[i, j] * 50;
- X steik;
- X steik;
- X steik;
- X steik;
- Xend { spread };
- X
- X{
- X gList is initialized with the size, loc, and libCount of each group
- X groupIDs contains the serial numbers of the groups.
- X}
- Xprocedure respreicen;
- Xvar
- X i, j, gID, libCount, gSize, who: integer;
- X
- X procedure span(x, y: integer);
- X begin { span }
- X if (bord[x, y] = 0) and
- X (markBoard[x, y] <> marker) then { a liberty }
- X begin
- X markBoard[x, y] := marker;
- X libCount := libCount + 1;
- X end
- X else if (bord[x, y] = who) and
- X (groupIDs[x, y] = 0) then
- X begin
- X groupIDs[x, y] := gID;
- X gSize := gSize + 1;
- X if x > 0 then
- X span(x - 1, y);
- X if x < maxPoint then
- X span(x + 1, y);
- X if y > 0 then
- X span(x, y - 1);
- X if y < maxPoint then
- X span(x, y + 1);
- X end;
- X end { span };
- X
- Xbegin { respreicen }
- X gID := 0;
- X for i := 0 to maxPoint do
- X for j := 0 to maxPoint do
- X groupIDs[i, j] := 0;
- X for i := 0 to maxPoint do
- X for j := 0 to maxPoint do
- X if (bord[i, j] <> 0) and { a stone there }
- X (groupIDs[i, j] = 0) then { not seen yet }
- X begin
- X marker := marker + 1;
- X if marker = 0 then
- X begin
- X initArray(markBoard);
- X marker := 1;
- X end;
- X gID := gID + 1;
- X libCount := 0;
- X gSize := 0;
- X who := bord[i, j];
- X span(i, j); { span the group, collecting info }
- X with gList[gID] do
- X begin
- X groupMark := 0;
- X atLevel := 0;
- X isLive := false; { we don't know yet }
- X isDead := false;
- X numEyes := -1;
- X size := gSize;
- X libC := libCount;
- X lx := i;
- X ly := j;
- X end;
- X gMap[gID] := gID; { set up identity map }
- X end;
- X maxGroupID := gID;
- X newGID := gID;
- X grpMark := 0;
- Xend { respreicen };
- X
- X{
- X play z at [x, y].
- X killFlag is set true if anything is killed.
- X}
- Xprocedure plei(x, y, z: integer);
- Xvar
- X i, me, him, myGID: integer;
- X isNew: boolean;
- X
- X procedure killGroup(x, y: integer);
- X begin { killGroup }
- X playMark := playMark + 1;
- X with playStack[playMark] do
- X begin { record this kill }
- X kind := rem;
- X who := him;
- X xl := x;
- X yl := y;
- X gID := groupIDs[x, y];
- X sNumber := board[x, y].mNum;
- X if showTrees then
- X rstone(x, y);
- X end;
- X numCapt := numCapt + 1;
- X bord[x, y] := 0;
- X groupIDs[x, y] := 0;
- X if x > 0 then
- X begin
- X if bord[x - 1, y] = me then
- X begin
- X nlcGroup.indx := nlcGroup.indx + 1;
- X nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x - 1, y]];
- X end
- X else if bord[x - 1, y] = him then
- X killGroup(x - 1, y);
- X end;
- X if x < maxPoint then
- X begin
- X if bord[x + 1, y] = me then
- X begin
- X nlcGroup.indx := nlcGroup.indx + 1;
- X nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x + 1, y]];
- X end
- X else if bord[x + 1, y] = him then
- X killGroup(x + 1, y);
- X end;
- X if y > 0 then
- X begin
- X if bord[x, y - 1] = me then
- X begin
- X nlcGroup.indx := nlcGroup.indx + 1;
- X nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x, y - 1]];
- X end
- X else if bord[x, y - 1] = him then
- X killGroup(x, y - 1);
- X end;
- X if y < maxPoint then
- X begin
- X if bord[x, y + 1] = me then
- X begin
- X nlcGroup.indx := nlcGroup.indx + 1;
- X nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x, y + 1]];
- X end
- X else if bord[x, y + 1] = him then
- X killGroup(x, y + 1);
- X end;
- X end { killGroup };
- X
- X procedure mergeGroup(sGID: integer);
- X var
- X i: integer;
- X begin { mergeGroup }
- X for i := 1 to newGID do
- X if gMap[i] = sGID then
- X begin
- X playMark := playMark + 1;
- X with playStack[playMark] do
- X begin
- X kind := reMap;
- X gID := i;
- X oldGID := sGID;
- X end;
- X gMap[i] := myGID;
- X end;
- X end { mergeGroup };
- X
- Xbegin { plei }
- X me := z;
- X him := -me;
- X killFlag := false; { set true if something is killed }
- X numCapt := 0;
- X tryLevel := tryLevel + 1;
- X isNew := false;
- X bord[x, y] := z; { play the stone }
- X if (x > 0) and (bord[x - 1, y] = me) then { connect to adjacent group }
- X myGID := gMap[groupIDs[x - 1, y]]
- X else if (x < maxPoint) and (bord[x + 1, y] = me) then
- X myGID := gMap[groupIDs[x + 1, y]]
- X else if (y > 0) and (bord[x, y - 1] = me) then
- X myGID := gMap[groupIDs[x, y - 1]]
- X else if (y < maxPoint) and (bord[x, y + 1] = me) then
- X myGID := gMap[groupIDs[x, y + 1]]
- X else { nobody to connect to }
- X begin
- X newGID := newGID + 1;
- X isNew := true;
- X myGID := newGID;
- X with gList[myGID] do
- X begin
- X groupMark := 0;
- X atLevel := tryLevel;
- X isLive := false;
- X numEyes := -1;
- X size := -1;
- X lx := x;
- X ly := y;
- X end;
- X gMap[myGID] := myGID;
- X end;
- X groupIDs[x, y] := myGID;
- X playMark := playMark + 1;
- X with playStack[playMark] do
- X begin { record this move }
- X kind := add;
- X who := me;
- X xl := x;
- X yl := y;
- X gID := myGID;
- X sNumber := 0;
- X if isNew then
- X nextGID := newGID - 1
- X else
- X nextGID := newGID;
- X if showTrees then
- X sstone(me, x, y, 0);
- X end;
- X { merge adjacent groups }
- X if (x > 0) and (bord[x - 1, y] = me) and
- X (gMap[groupIDs[x - 1, y]] <> myGID) then
- X mergeGroup(gMap[groupIDs[x - 1, y]]);
- X if (x < maxPoint) and (bord[x + 1, y] = me) and
- X (gMap[groupIDs[x + 1, y]] <> myGID) then
- X mergeGroup(gMap[groupIDs[x + 1, y]]);
- X if (y > 0) and (bord[x, y - 1] = me) and
- X (gMap[groupIDs[x, y - 1]] <> myGID) then
- X mergeGroup(gMap[groupIDs[x, y - 1]]);
- X if (y < maxPoint) and (bord[x, y + 1] = me) and
- X (gMap[groupIDs[x, y + 1]] <> myGID) then
- X mergeGroup(gMap[groupIDs[x, y + 1]]);
- X { kill opposing groups, listing affected groups }
- X nlcGroup.indx := 1;
- X nlcGroup.v[1] := myGID; { init list to include me }
- X if (x > 0) and (bord[x - 1, y] = him) and
- X (gList[gMap[groupIDs[x - 1, y]]].libC = 1) then
- X begin
- X killFlag := true;
- X killGroup(x - 1, y);
- X end;
- X if (x < maxPoint) and (bord[x + 1, y] = him) and
- X (gList[gMap[groupIDs[x + 1, y]]].libC = 1) then
- X begin
- X killFlag := true;
- X killGroup(x + 1, y);
- X end;
- X if (y > 0) and (bord[x, y - 1] = him) and
- X (gList[gMap[groupIDs[x, y - 1]]].libC = 1) then
- X begin
- X killFlag := true;
- X killGroup(x, y - 1);
- X end;
- X if (y < maxPoint) and (bord[x, y + 1] = him) and
- X (gList[gMap[groupIDs[x, y + 1]]].libC = 1) then
- X begin
- X killFlag := true;
- X killGroup(x, y + 1);
- X end;
- X { list groups adjacent to me }
- X if (x > 0) and (bord[x - 1, y] = him) then
- X begin
- X nlcGroup.indx := nlcGroup.indx + 1;
- X nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x - 1, y]];
- X end;
- X if (x < maxPoint) and (bord[x + 1, y] = him) then
- X begin
- X nlcGroup.indx := nlcGroup.indx + 1;
- X nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x + 1, y]];
- X end;
- X if (y > 0) and (bord[x, y - 1] = him) then
- X begin
- X nlcGroup.indx := nlcGroup.indx + 1;
- X nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x, y - 1]];
- X end;
- X if (y < maxPoint) and (bord[x, y + 1] = him) then
- X begin
- X nlcGroup.indx := nlcGroup.indx + 1;
- X nlcGroup.v[nlcGroup.indx] := gMap[groupIDs[x, y + 1]];
- X end;
- X { fix liberty count for affected groups }
- X grpMark := grpMark + 1;
- X for i := 1 to nlcGroup.indx do
- X with gList[nlcGroup.v[i]] do
- X if groupMark <> grpMark then
- X begin
- X if atLevel <> tryLevel then
- X begin
- X playMark := playMark + 1;
- X with playStack[playMark] do
- X begin
- X kind := chLib;
- X gID := nlcGroup.v[i];
- X oldLevel := atLevel;
- X oldLC := libC;
- X end;
- X end;
- X groupMark := grpMark;
- X atLevel := tryLevel;
- X spanGroup(lx, ly, pPList);
- X libC := pPList.indx;
- X end;
- Xend { plei };
- X
- Xprocedure saveState;
- Xbegin { saveState };
- X playMark := 0;
- X tryLevel := 0;
- X newGID := maxGroupID;
- Xend { saveState };
- X
- X{
- X undoes a move sequence back to uMark
- X}
- Xprocedure undoTo(uMark: integer);
- Xvar
- X i: integer;
- Xbegin { undoTo }
- X for i := playMark downto uMark + 1 do
- X with playStack[i] do
- X if kind = rem then
- X begin
- X bord[xl, yl] := who;
- X groupIDs[xl, yl] := gID;
- X if showTrees then
- X sstone(who, xl, yl, sNumber);
- X end
- X else if kind = add then
- X begin
- X bord[xl, yl] := 0;
- X groupIDs[xl, yl] := 0;
- X tryLevel := tryLevel - 1;
- X newGID := nextGID;
- X if showTrees then
- X rstone(xl, yl);
- X end
- X else if kind = reMap then
- X gMap[gID] := oldGID
- X else { change libs of group - gID is pre-mapped }
- X with gList[gID] do
- X begin
- X libC := oldLC;
- X atLevel := oldLevel;
- X end;
- X playMark := uMark;
- Xend { undoTo };
- X
- X{
- X restores the state of the world after trying a move sequence
- X}
- Xprocedure restoreState;
- Xvar
- X i: integer;
- Xbegin { restoreState }
- X if playMark > 0 then
- X begin
- X undoTo(0);
- X playMark := 0;
- X tryLevel := 0;
- X end;
- Xend { restoreState };
- X
- Xexception bpt;
- X
- X{
- X returns true if the group (at x, y) is killable.
- X if so, returns the point to play at in killx, killy.
- X}
- Xfunction killable(gx, gy: integer; var killx, killy: integer): boolean;
- Xconst
- X tryLimit = 300;
- X
- Xvar
- X me, him, depth, i, j, tryCount, tl, topMark, tkMark, mark2: integer;
- X sChar: char;
- X lList, dList: sPointList;
- X tp: point;
- X libList: array[1..maxSPoint] of integer;
- X esc: boolean;
- X
- X function mtNbrs(x, y: integer): integer;
- X var
- X n: integer;
- X begin { mtNbrs }
- X n := 0;
- X if (x > 0) and (bord[x - 1, y] = 0) then
- X n := n + 1;
- X if (x < maxPoint) and (bord[x + 1, y] = 0) then
- X n := n + 1;
- X if (y > 0) and (bord[x, y - 1] = 0) then
- X n := n + 1;
- X if (y < maxPoint) and (bord[x, y + 1] = 0) then
- X n := n + 1;
- X mtNbrs := n;
- X end { mtNbrs };
- X
- X function tKillTree(tx, ty: integer): boolean;
- X var
- X tkMark: integer;
- X escape: boolean;
- X
- X function killTree(tx, ty: integer; var escape: boolean): boolean;
- X label
- X 1, 2;
- X var
- X curMark, mark2, mark3, i, j, k, tl, dStart: integer;
- X lList1, lList2: sPointList;
- X libList: array[1..maxSPoint] of integer;
- X tp: point;
- X esc: boolean;
- X begin { killTree }
- X escape := false;
- X tryCount := tryCount + 1;
- X if tryCount > tryLimit then
- X begin
- X killable := false;
- X undoTo(tkMark);
- X for i := 1 to depth - 1 do
- X begin
- X sClearChar(sChar, rXor);
- X end;
- X depth := 1;
- X exit(tKilltree);
- X end;
- X write(sChar);
- X depth := depth + 1;
- X curMark := playMark;
- X plei(tx, ty, me); { try my move }
- X pause;
- X if gList[gMap[groupIDs[tx, ty]]].libC = 0 then { I'm dead }
- X killTree := false
- X else if killFlag then { I killed something of his }
- X killTree := true
- X else if gList[gMap[groupIDs[gx, gy]]].libC > treeLibLim then { safe }
- X killTree := false
- X else
- X begin
- X sSpanGroup(gx, gy, lList1); { find his liberties }
- X if gList[gMap[groupIDs[tx, ty]]].libC = 1 then { he can kill me }
- X begin
- X if lList1.indx < maxSPoint then { add that option to his list }
- X begin
- X lList1.indx := lList1.indx + 1;
- X spanGroup(tx, ty, pList2); { find my liberty }
- X with lList1.p[lList1.indx] do
- X begin
- X px := pList2.p[1].px;
- X py := pList2.p[1].py;
- X end;
- X end
- X else
- X begin
- X killTree := false; { forget it }
- X goto 1;
- X end;
- X end;
- X for i := 1 to maxSPoint do { init liblist so diags can be marked }
- X libList[i] := -1;
- X if (utilPlayLevel > 4) and
- X (lList1.indx > 1) and
- X (gList[gMap[groupIDs[gx, gy]]].libC > 1) then { try diags }
- X begin
- X listDiags(gx, gy, dList);
- X j := 0;
- X i := lList1.indx;
- X while (j < dList.indx) and
- X (i < maxSPoint) do
- X begin
- X j := j + 1;
- X i := i + 1;
- X libList[i] := 0; { mark this as a diag }
- X with dList.p[j] do
- X begin
- X lList1.p[i].px := px;
- X lList1.p[i].py := py;
- X end;
- X end;
- X lList1.indx := i;
- X end;
- X if lList1.indx > 1 then { sort by decreasing lib count }
- X begin
- X for i := 1 to lList1.indx do
- X if libList[i] <> 0 then { diags are tried last }
- X with lList1.p[i] do
- X begin
- X mark2 := playMark;
- X plei(px, py, him);
- X libList[i] := gList[gMap[groupIDs[gx, gy]]].libC;
- X if (libList[i] > treeLibLim) or
- X ((libList[i] > (depthLimit - depth)) and
- X (libList[i] > 2)) then
- X begin
- X escape := true;
- X killTree := false;
- X goto 1; { he can live }
- X end;
- X undoTo(mark2);
- X end;
- X for i := 1 to lList1.indx - 1 do
- X for j := i + 1 to lList1.indx do
- X if libList[i] < libList[j] then
- X begin
- X tl := libList[i];
- X libList[i] := libList[j];
- X libList[j] := tl;
- X tp := lList1.p[i];
- X lList1.p[i] := lList1.p[j];
- X lList1.p[j] := tp;
- X end;
- X end;
- X for i := 1 to lList1.indx + 1 do { try his responses }
- X begin
- X mark2 := playMark;
- X if i <= lList1.indx then { try his move }
- X with lList1.p[i] do
- X begin
- X plei(px, py, him); { play his response }
- X pause;
- X if gList[gMap[groupIDs[px, py]]].libC < 2 then
- X goto 2; { a bogus move }
- X end
- X else if gList[gMap[groupIDs[gx, gy]]].libC <= 1 then
- X begin
- X killTree := true; { can't tenuki if in atari }
- X goto 1;
- X end;
- X if gList[gMap[groupIDs[gx, gy]]].libC > treeLibLim then
- X begin
- X escape := true;
- X killTree := false;
- X goto 1;
- X end;
- X if gList[gMap[groupIDs[gx, gy]]].libC > 1 then
- X begin { look at my responses }
- X sSpanGroup(gx, gy, lList2); { list his liberties }
- X dStart := lList2.indx + 1;
- X if adjInAtari then { he wins }
- X begin
- X killTree := false;
- X goto 1;
- X end;
- X if (lList2.Indx > 2) and adj2Libs then { he wins }
- X begin
- X killTree := false;
- X goto 1;
- X end;
- X for k := 1 to maxSPoint do
- X libList[k] := -1;
- X if utilPlayLevel > 4 then { account for diagonal moves }
- X begin
- X listDiags(gx, gy, dList);
- X j := 0;
- X k := lList2.indx;
- X while (j < dList.indx) and
- X (k < maxSPoint) do
- X begin
- X j := j + 1;
- X k := k + 1;
- X libList[k] := 100;
- X with dList.p[j] do
- X begin
- X lList2.p[k].px := px;
- X lList2.p[k].py := py;
- X end;
- X end;
- X lList2.indx := k;
- X end;
- X if lList2.indx > 1 then { sort by increasing lib count }
- X begin
- X for k := 1 to lList2.indx do
- X if libList[k] <> 100 then { diags go last }
- X with lList2.p[k] do
- X begin
- X mark3 := playMark;
- X plei(px, py, me);
- X libList[k] := gList[gMap[groupIDs[gx, gy]]].libC;
- X undoTo(mark3);
- X end;
- X for k := 1 to lList2.indx - 1 do
- X for j := k + 1 to lList2.indx do
- X if libList[k] > libList[j] then
- X begin
- X tl := libList[k];
- X libList[k] := libList[j];
- X libList[j] := tl;
- X tp := lList2.p[k];
- X lList2.p[k] := lList2.p[j];
- X lList2.p[j] := tp;
- X end
- X else if (libList[k] = libList[j]) and
- X (libList[k] = 1) then
- X if mtNbrs(lList2.p[k].px, lList2.p[k].py) <
- X mtNbrs(lList2.p[j].px, lList2.p[j].py) then
- X begin
- X tl := libList[k];
- X libList[k] := libList[j];
- X libList[j] := tl;
- X tp := lList2.p[k];
- X lList2.p[k] := lList2.p[j];
- X lList2.p[j] := tp;
- X end;
- X end;
- X for j := 1 to lList2.indx do
- X begin
- X if killTree(lList2.p[j].px, lList2.p[j].py, esc) then
- X goto 2; { this kills him }
- X if esc and (j >= dStart) then
- X begin
- X killTree := false;
- X goto 1; { don't bother with more diags if escapes }
- X end;
- X end;
- X killTree := false; { none of my responses kills him }
- X goto 1;
- X end;
- X 2:
- X undoTo(mark2);
- X end;
- X killTree := true; { none of his responses saves him }
- X end;
- X 1:
- X undoTo(curMark);
- X sClearChar(sChar, rXor);
- X depth := depth - 1;
- X end { killTree };
- X
- X begin { tKillTree }
- X tryCount := 0;
- X tkMark := playMark;
- X tKillTree := killTree(tx, ty, escape);
- X end { tKillTree };
- X
- Xbegin { killable }
- X dbStop := true;
- X him := bord[gx, gy]; { find out who I am }
- X me := -him;
- X if me = 1 then
- X sChar := '>'
- X else
- X sChar := '|';
- X write(sChar);
- X depth := 1;
- X topMark := playMark;
- X sSpanGroup(gx, gy, lList); { find his liberties }
- X if lList.indx = 1 then
- X begin
- X killable := true;
- X killx := lList.p[1].px;
- X killy := lList.p[1].py;
- X end
- X else if lList.indx > treeLibLim then
- X killable := false
- X else if adjInAtari then
- X killable := false
- X else if (lList.indx > 2) and adj2Libs then
- X killable := false
- X else
- X begin
- X for i := 1 to maxSPoint do
- X libList[i] := -1;
- X if utilPlayLevel > 4 then { account for diagonal moves }
- X begin
- X listDiags(gx, gy, dList);
- X j := 0;
- X i := lList.indx;
- X while (j < dList.indx) and
- X (i < maxSPoint) do
- X begin
- X j := j + 1;
- X i := i + 1;
- X libList[i] := 100;
- X with dList.p[j] do
- X begin
- X lList.p[i].px := px;
- X lList.p[i].py := py;
- X end;
- X end;
- X lList.indx := i;
- X end;
- X if lList.indx > 1 then { sort by increasing lib count }
- X begin
- X for i := 1 to lList.indx do
- X if libList[i] <> 100 then { diags go last }
- X with lList.p[i] do
- X begin
- X mark2 := playMark;
- X plei(px, py, me);
- X libList[i] := gList[gMap[groupIDs[gx, gy]]].libC;
- X undoTo(mark2);
- X end;
- X for i := 1 to lList.indx - 1 do
- X for j := i + 1 to lList.indx do
- X if libList[i] > libList[j] then
- X begin
- X tl := libList[i];
- X libList[i] := libList[j];
- X libList[j] := tl;
- X tp := lList.p[i];
- X lList.p[i] := lList.p[j];
- X lList.p[j] := tp;
- X end
- X else if (libList[i] = libList[j]) and
- X (libList[i] = 1) then
- X if mtNbrs(lList.p[i].px, lList.p[i].py) <
- X mtNbrs(lList.p[j].px, lList.p[j].py) then
- X begin
- X tl := libList[i];
- X libList[i] := libList[j];
- X libList[j] := tl;
- X tp := lList.p[i];
- X lList.p[i] := lList.p[j];
- X lList.p[j] := tp;
- X end;
- X end;
- X for i := 1 to lList.indx do
- X begin
- X if legal[lList.p[i].px, lList.p[i].py] then
- X begin
- X killx := lList.p[i].px;
- X killy := lList.p[i].py;
- X if tKillTree(killx, killy) then
- X begin
- X killable := true;
- X sClearChar(sChar, rXor);
- X exit(killable);
- X end;
- X end;
- X end;
- X killable := false;
- X end;
- X sClearChar(sChar, rXor);
- Xend { killable };
- X
- X{
- X returns true if the group (at gx, gy) is saveable.
- X if so, returns the point to play at in savex, savey
- X}
- Xfunction saveable(gx, gy: integer; var savex, savey: integer): boolean;
- Xlabel
- X 1;
- Xvar
- X me, him, gx1, gx2, i, j, smark, mark2, tl: integer;
- X sChar: char;
- X dList: sPointList;
- X tp: point;
- X libList: array[1..maxSPoint] of integer;
- Xbegin { saveable }
- X dbStop := true;
- X me := bord[gx, gy];
- X him := -me;
- X if me = 1 then
- X sChar := '|'
- X else
- X sChar := '>';
- X write(sChar);
- X spanGroup(gx, gy, pList3); { find my liberties }
- X if adjInAtari then { one of my options is to kill }
- X begin
- X listAdjacents(gx, gy, aList);
- X for i := 1 to aList.indx do
- X if gList[aList.v[i]].libC = 1 then
- X with gList[aList.v[i]] do
- X begin
- X spanGroup(lx, ly, pList1); { find it's liberty }
- X pList3.indx := pList3.indx + 1;
- X pList3.p[pList3.indx].px := pList1.p[1].px;
- X pList3.p[pList3.indx].py := pList1.p[1].py;
- X end;
- X end;
- X for i := 1 to maxSPoint do
- X libList[i] := -1;
- X if (utilPlayLevel > 4) and
- X (gList[gMap[groupIDs[gx, gy]]].libC > 1) then { account for diags }
- X begin
- X listDiags(gx, gy, dList);
- X j := 0;
- X i := pList3.indx;
- X while (j < dList.indx) and
- X (i < maxSPoint) do
- X begin
- X j := j + 1;
- X i := i + 1;
- X libList[i] := 100;
- X with dList.p[j] do
- X begin
- X pList3.p[i].px := px;
- X pList3.p[i].py := py;
- X end;
- X end;
- X pList3.indx := i;
- X end;
- X if pList3.indx > 1 then { sort by decreasing lib count }
- X begin
- X for i := 1 to pList3.indx do
- X if libList[i] <> 100 then
- X with pList3.p[i] do
- X begin
- X mark2 := playMark;
- X plei(px, py, me);
- X libList[i] := gList[gMap[groupIDs[gx, gy]]].libC;
- X if libList[i] > treeLibLim then { i'm safe }
- X begin
- X savex := px;
- X savey := py;
- X saveable := true;
- X goto 1;
- X end;
- X undoTo(mark2);
- X end;
- X for i := 1 to pList3.indx - 1 do
- X for j := i + 1 to pList3.indx do
- X if libList[i] < libList[j] then
- X begin
- X tl := libList[i];
- X libList[i] := libList[j];
- X libList[j] := tl;
- X tp := pList3.p[i];
- X pList3.p[i] := pList3.p[j];
- X pList3.p[j] := tp;
- X end;
- X end;
- X for i := 1 to pList3.indx do
- X begin
- X savex := pList3.p[i].px;
- X savey := pList3.p[i].py;
- X if legal[savex, savey] then
- X begin
- X smark := playMark;
- X plei(savex, savey, me);
- X pause;
- X if gList[gMap[groupIDs[savex, savey]]].libC > 1 then
- X if gList[gMap[groupIDs[gx, gy]]].libC > treeLibLim then
- X begin
- X saveable := true;
- X restoreState;
- X sClearChar(sChar, rXor);
- X exit(saveable);
- X end
- X else if gList[gMap[groupIDs[gx, gy]]].libC > 1 then
- X if not killable(gx, gy, gx1, gx2) then
- X begin
- X saveable := true;
- X restoreState;
- X sClearChar(sChar, rXor);
- X exit(saveable);
- X end;
- X undoTo(smark);
- X end;
- X end;
- X saveable := false;
- X1:
- X restoreState;
- X sClearChar(sChar, rXor);
- Xend { saveable };
- X
- X{
- X marks unsavable groups as dead
- X}
- Xprocedure markDead;
- Xvar
- X i, j, gx, gy: integer;
- Xbegin { markDead }
- X for i := 1 to maxGroupID do
- X with gList[i] do
- X if killable(lx, ly, gx, gy) then
- X isDead := not saveable(lx, ly, gx, gy)
- X else
- X isDead := false;
- X for i := 0 to maxPoint do
- X for j := 0 to maxPoint do
- X if bord[i, j] = 0 then
- X ndbord[i, j] := 0
- X else if gList[groupIDs[i, j]].isDead then
- X ndbord[i, j] := 0
- X else
- X ndbord[i, j] := bord[i, j];
- Xend { markDead };
- X
- X{
- X marks groups with two eyes as live
- X}
- Xprocedure markLive;
- Xvar
- X i, j, size, sMark: integer;
- X saw1, sawm1: boolean;
- X
- X procedure span(x, y: integer);
- X begin { span }
- X if ndbord[x, y] = 1 then
- X saw1 := true
- X else if ndbord[x, y] = -1 then
- X sawm1 := true
- X else if sGroups[x, y] = 0 then
- X begin
- X sGroups[x, y] := sMark;
- X size := size + 1;
- X if x > 0 then
- X span(x - 1, y);
- X if x < maxPoint then
- X span(x + 1, y);
- X if y > 0 then
- X span(x, y - 1);
- X if y < maxPoint then
- X span(x, y + 1);
- X end;
- X end { span };
- X
- X function checkLive(x, y: integer): boolean;
- X var
- X numEyes, who: integer;
- X
- X procedure span(x, y: integer);
- X begin { span }
- X markBoard[x, y] := marker;
- X if ndbord[x, y] = 0 then
- X with sList[sGroups[x, y]] do
- X begin
- X if (sm <> marker) and
- X (w = who) then
- X begin
- X sm := marker;
- X if s > 6 then
- X exit(checkLive);
- X numEyes := numEyes + 1;
- X if numEyes > 1 then
- X exit(checkLive);
- X end;
- X end
- X else if bord[x, y] = who then
- X begin
- X if (x > 0) and
- X (markBoard[x - 1, y] <> marker) then
- X span(x - 1, y);
- X if (x < maxPoint) and
- X (markBoard[x + 1, y] <> marker) then
- X span(x + 1, y);
- X if (y > 0) and
- X (markBoard[x, y - 1] <> marker) then
- X span(x, y - 1);
- X if (y < maxPoint) and
- X (markBoard[x, y + 1] <> marker) then
- X span(x, y + 1);
- X end;
- X end { span };
- X
- X begin { checkLive }
- X checkLive := true;
- X numEyes := 0;
- X who := bord[x, y];
- X marker := marker + 1;
- X span(x, y);
- X checkLive := false;
- X end { checkLive };
- X
- Xbegin { markLive }
- X sMark := 0;
- X initArray(sGroups);
- X for i := 0 to maxPoint do
- X for j := 0 to maxPoint do
- X if (sGroups[i, j] = 0) and
- X (ndbord[i, j] = 0) then
- X begin
- X size := 0;
- X sMark := sMark + 1;
- X sawm1 := false;
- X saw1 := false;
- X span(i, j);
- X sList[sMark].s := size;
- X sList[sMark].sm := 0;
- X if sawm1 then
- X if saw1 then
- X sList[sMark].w := 0
- X else
- X sList[sMark].w := -1
- X else if saw1 then
- X sList[sMark].w := 1
- X else
- X sList[sMark].w := 0;
- X end;
- X for i := 1 to maxGroupID do
- X with gList[i] do
- X if not isDead then
- X isLive := checkLive(lx, ly);
- Xend { markLive };
- X
- X{
- X generates the connection map and the protected point map.
- X}
- Xprocedure genConnects;
- Xvar
- X x, y, numStones: integer;
- Xbegin { genConnects }
- X for x := 0 to maxPoint do
- X for y := 0 to maxPoint do
- X begin
- X connectMap[x, y] := 0;
- X protPoints[x, y] := 0;
- X end;
- X for x := 0 to maxPoint do
- X for y := 0 to maxPoint do
- X if bord[x, y] = 1 then { map connections to this stone }
- X begin
- X if x > 0 then { direct connection }
- X connectMap[x - 1, y] := connectMap[x - 1, y] + 1;
- X if x < maxPoint then
- X connectMap[x + 1, y] := connectMap[x + 1, y] + 1;
- X if y > 0 then
- X connectMap[x, y - 1] := connectMap[x, y - 1] + 1;
- X if y < maxPoint then
- X connectMap[x, y + 1] := connectMap[x, y + 1] + 1;
- X if (x > 0) and (y > 0) and { diagonal connection }
- X (bord[x - 1, y] = 0) and (bord[x, y - 1] = 0) then
- X connectMap[x - 1, y - 1] := connectMap[x - 1, y - 1] + 1;
- X if (x < maxPoint) and (y > 0) and
- X (bord[x + 1, y] = 0) and (bord[x, y - 1] = 0) then
- X connectMap[x + 1, y - 1] := connectMap[x + 1, y - 1] + 1;
- X if (x < maxPoint) and (y < maxPoint) and
- X (bord[x + 1, y] = 0) and (bord[x, y + 1] = 0) then
- X connectMap[x + 1, y + 1] := connectMap[x + 1, y + 1] + 1;
- X if (x > 0) and (y < maxPoint) and
- X (bord[x - 1, y] = 0) and (bord[x, y + 1] = 0) then
- X connectMap[x - 1, y + 1] := connectMap[x - 1, y + 1] + 1;
- X if (x > 1) and (kleim[x - 1, y] > 3) then { one point jump }
- X connectMap[x - 2, y] := connectMap[x - 2, y] + 1;
- X if (x < (maxPoint - 1)) and (kleim[x + 1, y] > 3) then
- X connectMap[x + 2, y] := connectMap[x + 2, y] + 1;
- X if (y > 1) and (kleim[x, y - 1] > 3) then
- X connectMap[x, y - 2] := connectMap[x, y - 2] + 1;
- X if (y < (maxPoint - 1)) and (kleim[x, y + 1] > 3) then
- X connectMap[x, y + 2] := connectMap[x, y + 2] + 1;
- X if (x > 1) and (y > 0) and { knight's move }
- X (kleim[x - 1, y] > 3) and (kleim[x - 1, y - 1] > 3) then
- X connectMap[x - 2, y - 1] := connectMap[x - 2, y - 1] + 1;
- X if (x > 0) and (y > 1) and
- X (kleim[x, y - 1] > 3) and (kleim[x - 1, y - 1] > 3) then
- X connectMap[x - 1, y - 2] := connectMap[x - 1, y - 2] + 1;
- X if (x < (maxPoint - 1)) and (y > 0) and
- X (kleim[x + 1, y] > 3) and (kleim[x + 1, y - 1] > 3) then
- X connectMap[x + 2, y - 1] := connectMap[x + 2, y - 1] + 1;
- X if (x < maxPoint) and (y > 1) and
- X (kleim[x, y - 1] > 3) and (kleim[x + 1, y - 1] > 3) then
- X connectMap[x + 1, y - 2] := connectMap[x + 1, y - 2] + 1;
- X if (x > 1) and (y < maxPoint) and
- X (kleim[x - 1, y] > 3) and (kleim[x - 1, y + 1] > 3) then
- X connectMap[x - 2, y + 1] := connectMap[x - 2, y + 1] + 1;
- X if (x > 0) and (y < (maxPoint - 1)) and
- X (kleim[x, y + 1] > 3) and (kleim[x - 1, y + 1] > 3) then
- X connectMap[x - 1, y + 2] := connectMap[x - 1, y + 2] + 1;
- X if (x < (maxPoint - 1)) and (y < maxPoint) and
- X (kleim[x + 1, y] > 3) and (kleim[x + 1, y + 1] > 3) then
- X connectMap[x + 2, y + 1] := connectMap[x + 2, y + 1] + 1;
- X if (x < maxPoint) and (y < (maxPoint - 1)) and
- X (kleim[x, y + 1] > 3) and (kleim[x + 1, y + 1] > 3) then
- X connectMap[x + 1, y + 2] := connectMap[x + 1, y + 2] + 1;
- X end
- X else if bord[x, y] = 0 then { see if protected point }
- X begin
- X numStones := 0;
- X if x = 0 then
- X numStones := numStones + 1;
- X if y = 0 then
- X numStones := numStones + 1;
- X if x = maxPoint then
- X numStones := numStones + 1;
- X if y = maxPoint then
- X numStones := numStones + 1;
- X if (x > 0) and (bord[x - 1, y] = 1) then
- X numStones := numStones + 1;
- X if (y > 0) and (bord[x, y - 1] = 1) then
- X numStones := numStones + 1;
- X if (x < maxPoint) and (bord[x + 1, y] = 1) then
- X numStones := numStones + 1;
- X if (y < maxPoint) and (bord[x, y + 1] = 1) then
- X numStones := numStones + 1;
- X if numStones = 4 then
- X protPoints[x, y] := 1
- X else if numStones = 3 then
- X begin
- X if (x > 0) and
- X ((bord[x - 1, y] = 0) or
- X ((bord[x - 1, y] = -1) and
- X (gList[groupIDs[x - 1, y]].libC = 1))) then
- X protPoints[x, y] := 1
- X else if (x < maxPoint) and
- X ((bord[x + 1, y] = 0) or
- X ((bord[x + 1, y] = -1) and
- X (gList[groupIDs[x + 1, y]].libC = 1))) then
- X protPoints[x, y] := 1
- X else if (y > 0) and
- X ((bord[x, y - 1] = 0) or
- X ((bord[x, y - 1] = -1) and
- X (gList[groupIDs[x, y - 1]].libC = 1))) then
- X protPoints[x, y] := 1
- X else if (y < maxPoint) and
- X ((bord[x, y + 1] = 0) or
- X ((bord[x, y + 1] = -1) and
- X (gList[groupIDs[x, y + 1]].libC = 1))) then
- X protPoints[x, y] := 1
- X end;
- X end;
- X for x := 0 to maxPoint do
- X for y := 0 to maxPoint do
- X if bord[x, y] <> 0 then
- X begin
- X connectMap[x, y] := 0;
- X protPoints[x, y] := 0;
- X end;
- Xend { genConnects };
- X
- X{
- X generates the whole state of the game.
- X}
- Xprocedure genState;
- Xvar
- X i, j: integer;
- Xbegin { genState }
- X inGenState := true;
- X respreicen;
- X markDead;
- X markLive;
- X spread;
- X genConnects;
- X inGenState := false;
- Xend { genState };
- X
- X{
- X generates a value for the [x, y] location that appears to get larger
- X for points that are saddle points in the influence graph (klein)
- X}
- Xfunction tencen(x, y: integer): integer;
- Xvar
- X a, b, c, d, w, z: integer;
- Xbegin { tencen }
- X if kleim[x, y] > -1 then { if he does not influence this area, return 50 }
- X begin
- X tencen := 50;
- X exit(tencen);
- X end;
- X w := kleim[x, y]; { w <= -1 }
- X a := iNil;
- X if x > 0 then
- X if kleim[x - 1, y] > -1 then { if neighbor is not influenced by him }
- X a := kleim[x - 1, y] - w; { score is sum of his influence on central }
- X b := iNil; { point and my influence on this neighbor }
- X if y > 0 then
- X if kleim[x, y - 1] > -1 then
- X b := kleim[x, y - 1] - w;
- X c := iNil;
- X if x < maxPoint then
- X if kleim[x + 1, y] > -1 then
- X c := kleim[x + 1, y] - w;
- X d := iNil;
- X if y < maxPoint then
- X if kleim[x, y + 1] > -1 then
- X d := kleim[x, y + 1] - w;
- X z := a; { z := max(a, b, c, d) }
- X if z <> iNil then
- X begin
- X if (b <> iNil) and
- X (b > z) then
- X z := b;
- X end
- X else
- X z := b;
- X if z <> iNil then
- X begin
- X if (c <> iNil) and
- X (c > z) then
- X z := c;
- X end
- X else
- X z := c;
- X if z <> iNil then
- X begin
- X if (d <> iNil) and
- X (d > z) then
- X z := d;
- X end
- X else
- X z := d;
- X if (z <> iNil) and
- X ((x = 0) or
- X (y = 0) or
- X (x = maxPoint) or
- X (y = maxPoint)) then
- X z := z * 2; { double z if on the edge of the board ?? }
- X if z <> iNil then
- X tencen := z
- X else
- X tencen := 50;
- Xend { tencen };
- X
- Xprocedure initGPUtils;
- Xbegin { initGPUtils }
- X initArray(markBoard);
- X initState;
- X marker := 0;
- X playMark := 0;
- X with gList[0] do
- X begin
- X isLive := false;
- X isDead := false;
- X libC := 0;
- X size := 0;
- X numEyes := 0;
- X lx := -1;
- X ly := -1;
- X end;
- X gMap[0] := 0;
- X dbStop := false;
- X inGenState := false;
- Xend. { initGPUtils }
- X
- END_OF_goPlayUtils.pas
- if test 50784 -ne `wc -c <goPlayUtils.pas`; then
- echo shar: \"goPlayUtils.pas\" unpacked with wrong size!
- fi
- # end of overwriting check
- fi
- echo shar: End of archive 1 \(of 5\).
- cp /dev/null ark1isdone
- MISSING=""
- for I in 1 2 3 4 5 ; do
- if test ! -f ark${I}isdone ; then
- MISSING="${MISSING} ${I}"
- fi
- done
- if test "${MISSING}" = "" ; then
- echo You have unpacked all 5 archives.
- rm -f ark[1-9]isdone
- else
- echo You still need to unpack the following archives:
- echo " " ${MISSING}
- fi
- ## End of shell archive.
- exit 0
-